home *** CD-ROM | disk | FTP | other *** search
/ Aminet 30 / Aminet 30 (1999)(Schatztruhe)[!][Apr 1999].iso / Aminet / dev / basic / NewFDConvert.lha / NewFDConvert / newfdconvert.asc < prev    next >
Text File  |  1999-01-16  |  13KB  |  596 lines
  1. ;last modified JAN 15 1999 by Curt Esser
  2.  
  3. ;NEEDS Blitzlibs:amigalibs.res!
  4.  
  5.  
  6. ;CHANGED - checks for clashing lib numbers
  7.  
  8. ;CHANGED - uses ReqTools for ALL requesters
  9.  
  10. ;CHANGED - scans Userlibs/ and Otherlibs/ directories too
  11.  
  12. ;CHANGED - option to over-write existing library files
  13. ;        - if overwritten, same lib # is re-used to
  14. ;        - prevent tokenization problems with old sources
  15.  
  16. ;CHANGED - larger window to see all commands in .fd file
  17.  
  18. ;CHANGED - useless window close gadget removed
  19.  
  20. ;ADDED   - doesn't quit until asked to by user
  21.  
  22. ;ADDED   - can call "MakeDefLibs" (or other) program
  23.  
  24. ;ADDED   - gave window a re-size gadget
  25.  
  26. ;ADDED   - doesn't automatically quit if
  27. ;        - library Exists and user cancels overwrite
  28.  
  29. ; -----------------------------------------------------------------
  30.  
  31. ; fdconvert.bb2 with added file requesters!
  32.  
  33. ; Right, now create Resource fixed
  34.  
  35. ; Now the program presents you the best library ID !!!
  36.  
  37. ; And now the executable don' t suxx if the library isn' t available...
  38.  
  39. v$="$VER: NewFDConvert v1.1 (12-27-1998) ACID/JLB"
  40.  
  41. WBStartup
  42. NoCli
  43. WBenchToFront_
  44. FindScreen 0        ;grab the WB screen
  45.  
  46. MaxLen p$=192
  47. MaxLen f$=192
  48. MaxLen fdpa$=192
  49. MaxLen lib$=192     ;for file requesters
  50.  
  51. lib$="LIBS:"        ;default path to actual libraries
  52.  
  53. Dim usedlibs.w(255) ;is this lib number in use?
  54.  
  55. bar$=Chr$(10)       ;for the RT requesters
  56.  
  57. cq$="Continue|  Quit  "
  58.  
  59. Dim d$(3)                        ;the directories to be scanned
  60. d$(1)="BlitzLibs:AmigaLibs/"     ;for Blitz libraries
  61. d$(2)="Blitzlibs:OtherLibs/"     ;assumes standard setup
  62. d$(3)="Blitzlibs:UserLibs/"      ;and "Blitzlibs:" assign!
  63.  
  64.  
  65.  
  66. ;-------------- makes a RTrequester-compatable string ----------
  67. ;                    of the free library numbers
  68.  
  69. Function.s MakeFreeList{}
  70. SHARED usedlibs(),bar$
  71. Format "000"
  72. For i = 1 To 255
  73.   If usedlibs(i)=0         ;ah, a free library number!
  74.     ret$=ret$+Str$(i)+" "
  75.     curlen.w+4
  76.     If curlen>60
  77.       ret$+bar$
  78.       curlen=0
  79.     EndIf
  80.   EndIf
  81. Next
  82. Format ""
  83. Function Return ret$
  84. End Function
  85. ;--------------------------------------------------------------
  86. Statement align{}
  87. ;
  88. SHARED co$
  89. ;
  90. l.q=Len(co$)
  91. If l/2<>Int(l/2) Then co$+Chr$(0)
  92. ;
  93. End Statement
  94. ;--------------------------------------------------------------
  95.  
  96. Statement fillin{src.l} ;src=source to change
  97. ;
  98. SHARED co$
  99. ;
  100. co$=Left$(co$,src)+Mkl$(Len(co$))+Mid$(co$,src+5)
  101. ;
  102. End Statement
  103. ;---------------------------------------------------------------
  104.  
  105.  
  106.  
  107. Statement dir{}                     ;scans directories for free library
  108. SHARED usedlibs(),d$()              ;numbers
  109.   libnr.w=0
  110.  
  111.   For d.b=1 To 3
  112.     dev$=d$(d)
  113.     ;dev$="Blitzlibs:Amigalibs/"
  114.     lock.l=Lock_(&dev$,-2)
  115.     If lock
  116.       WColour 2,0
  117.       NPrint " Checking ",dev$
  118.       WPrintScroll
  119.       WColour 1,0
  120.       infoadr.l=AllocMem_(260,0)
  121.       If infoadr
  122.         ok=Examine_(lock,infoadr)
  123.         Repeat
  124.           ok=ExNext_(lock,infoadr)
  125.           If ok AND Peek.l(infoadr+4)=-3 AND Instr(UCase$(Peek$(infoadr+8)),".INFO")=0
  126.               rfile$=dev$+Peek$(infoadr+8)
  127.               fh.l=Open_(&rfile$,1005)
  128.               If fh
  129.                 Seek_ fh,36,#OFFSET_CURRENT ;36 & 86
  130.                 Read_ fh,&libnr,2
  131.                 usedlibs(libnr)=1
  132.                 Close_ fh
  133.               EndIf
  134.           EndIf
  135.         Until ok=0
  136.         FreeMem_ infoadr,260
  137.       EndIf
  138.       UnLock_(lock)
  139.     Else
  140.       BeepScreen 0
  141.       WColour 3,0
  142.       NPrint " Can't locate ",dev$
  143.       WPrintScroll
  144.       WColour 1,0
  145.     EndIf
  146.   Next d
  147.   NPrint" "
  148.   WPrintScroll
  149. End Statement
  150.  
  151. ;---------------------------------------------------------------
  152.  
  153. Function$ ReadTtype{TT$}       ;read the tooltype if found
  154.   If FindToolType(TT$)
  155.     tl$=FindToolValue(TT$)
  156.   Else
  157.     tl$="0"
  158.   EndIf
  159.   Function Return tl$
  160. End Function
  161.  
  162.  
  163.  
  164. ;================================================================
  165.  
  166. ; ------------- Set up ----------------
  167.  
  168. *SC.Screen=Peek.l(Addr Screen(0))     ; get a pointer to screen
  169. *SCFONT.TextAttr=*SC.Screen\Font      ; and to the screen's font
  170. HEIGHT_WBFONT.b=(*SCFONT.TextAttr\ta_YSize) ; get font height
  171. fname$=Peek$(*SCFONT.TextAttr\ta_Name); and font name
  172.  
  173. LoadFont 0,fname$,HEIGHT_WBFONT       ; load font name,font height
  174.  
  175. ww.w=520                              ; width of window
  176. wh.w=160                              ; height of window
  177. wx.w=ScreenWidth/2-ww/2               ; centre...
  178. ;wy.w=ScreenHeight/2-wh/2              ; ...window
  179. wy=HEIGHT_WBFONT+5                    ;put it just below WB title bar
  180.  
  181. If Window (0,wx,wy,ww,wh,$400|$1|$4|$20," NewFDConvert",1,0)=0
  182.   dummy.b=RTEZRequest ("NewFDConvert","Failed to open window!","END")
  183.   End                                 ; quit if window can't open
  184. EndIf
  185.  
  186. ;----------- Read the icon for the command button info ----------
  187.  
  188. If GetIconObject("NewFdConvert")
  189.   cmd$=ReadTtype{"COMMAND"}          ;the command
  190.   pth$=ReadTtype{"PATH"}             ;path to the command
  191.   param$=ReadTtype{"PARAM"}            ;optional parameters
  192. EndIf
  193.  
  194. If cmd$="0"
  195.   btn$=cq$
  196. Else
  197.   If pth$<>"0" Then exe$=pth$
  198.   exe$+cmd$
  199.   If param$<>"0" Then exe$+" "+param$
  200.   btn$="Continue|"+cmd$+"|  Quit  "
  201. EndIf
  202.  
  203. dp$=ReadTtype{"FD_PATH"}          ;set default path to fd files
  204. If dp$<>"0"
  205.   fdpa$=dp$
  206. Else
  207.   fdpa$="RAM:"
  208. EndIf
  209.  
  210. ;-----------------------------------------------------------------
  211.  
  212. CatchDosErrs
  213.  
  214. NPrint " **       NewFDConvert        **"
  215. WPrintScroll
  216. NPrint " "
  217. WPrintScroll
  218. NPrint " v1.0         by James L Boyd"
  219. WPrintScroll
  220. NPrint " v1.1 mods    by Curt Esser"
  221. WPrintScroll
  222. NPrint "      - based on:"
  223. WPrintScroll
  224. NPrint " FDConv       by Mark Sibly"
  225. WPrintScroll
  226. NPrint " FDConv v2.0  by Andre Bergmann"
  227. WPrintScroll
  228.  
  229. NPrint " "
  230. WPrintScroll
  231.  
  232. DEFTYPE.l
  233. ;
  234. ;fdinfo prog... suss out an fd file, and return library offsets!
  235. ;
  236.  
  237.  
  238. ; --------- MAIN LOOP ----------------------------------
  239.  
  240. Repeat
  241. f$=""
  242. fd$=ASLFileRequest$("Select .fd file",fdpa$,f$,"#?.fd")
  243. If fd$="" OR f$="" Then End
  244. f$=""
  245. dest$="blitzlibs:amigalibs/"
  246.  
  247. Activate 0
  248.  
  249. Dim n$(1000),h$(1000),p$(1000),o.w(1000)
  250. Dim l$(10),ln(10) ;max libs split-up
  251.  
  252. If ReadFile(0,fd$)
  253.   NPrint " Examining FD File..."
  254.   WPrintScroll
  255.   FileInput 0:Gosub sussfd:CloseFile 0:Use Window 0
  256.   ;
  257.   ;ok... fd file sussed - now to make output file...
  258.   ;
  259.   Gosub makelib
  260.  
  261.   If userabort.b=0
  262.     rq$=li$+" saved!"+bar$+"Don't forget to remake your DefLibs"
  263.     answer.b=RTEZRequest (" Library done!",rq$,btn$)
  264.   Else
  265.     rq$="Library conversion aborted"
  266.     userabort=0
  267.     answer=RTEZRequest (" NewFdConvert",rq$,cq$)
  268.   EndIf
  269.  
  270.   If answer=2                    ;run "button" command
  271.     Execute_ exe$,0,0
  272.     answer=RTEZRequest (" NewFdConvert","-- Ready --",cq$)
  273.   EndIf
  274.  
  275. Else
  276.   answer=RTEZRequest("ERROR","Couldn't read .fd file",cq$)
  277. EndIf
  278.  
  279. If answer<>0
  280.   Use Window 0
  281.   For i = 1 To 10
  282.     NPrint " "
  283.     WPrintScroll
  284.   Next
  285.   WColour 2,0
  286.   NPrint " -------  READY  --------"
  287.   For i = 1 To 3
  288.     NPrint " "
  289.     WPrintScroll
  290.   Next
  291.   WColour 1,0
  292. EndIf
  293.  
  294. Until answer=0   ;quit selected on one of the requesters
  295.  
  296. End
  297.  
  298. ;-----------------------------------------------------------------
  299.  
  300. .makelib  ;n=number of commands...
  301. here0
  302. ll.l=OldOpenLibrary_(&li$)
  303. If ll
  304.   CloseLibrary_ ll:islib=-1
  305. Else
  306.   ll.l=OpenResource_(&li$)
  307.   If ll
  308.     islib=0
  309.   Else
  310.     li$=ASLFileRequest$("Library name",lib$,f$,"#?.library")
  311.     li$=f$
  312.     If li$=""
  313.       userabort=1
  314.       Return
  315.     EndIf
  316.     Goto here0
  317.   EndIf
  318. EndIf
  319. ;
  320. ;li$=library name! - generate amigalibs name
  321. ;
  322. nl=(n-1)/127+1  ;how many libs to make
  323. Print " Library will require ",nl
  324. Print" Amigalibs file"
  325. If nl>1 Then Print"s"
  326. NPrint"..."
  327. WPrintScroll
  328. NPrint" "
  329. WPrintScroll
  330.  
  331. For k=1 To nl   ;this bit determines the library numbers...
  332.  
  333.   fh.l=Open_(dest$+li$+Str$(k),#MODE_OLDFILE)
  334.   If fh
  335.     Seek_ fh,36,#OFFSET_CURRENT ;36 & 86
  336.     Read_ fh,&libnr.w,2
  337.     Close_ fh
  338.  
  339.     If k=1       ;only do this if first one of >1 part library!
  340.  
  341.       rq$="WARNING - Library already exists!"+bar$
  342.       rq$=rq$+dest$+li$+" id#:"+Str$(libnr)
  343.       answer.b=RTEZRequest ("NewFDConvert",rq$,"OverWrite|Cancel")
  344.       If answer=0
  345.         ;End
  346.         Pop For
  347.         userabort.b=1
  348.         Return
  349.       EndIf
  350.  
  351.     EndIf
  352.  
  353.     DeleteFile_(dest$+li$+Str$(k))
  354.     didhave.w=libnr
  355.     usedlibs(didhave)=0
  356.     WColour 3,0
  357.     NPrint " Existing ",li$+Str$(k)," deleted!"
  358.     WPrintScroll
  359.     NPrint " "
  360.     WPrintScroll
  361.     WColour 1,0
  362.   EndIf
  363.   If didhave              ;if an overwrite, always use same lib #(s)
  364.     ln(k)=didhave
  365.     didhave=0
  366.   Else
  367.     dir{}                 ;check numbers of existing libraries
  368.     For i = 255 To 1 Step -1
  369.       If usedlibs(i)=0
  370.         bestlibnr=i
  371.         i=1
  372.       EndIf
  373.     Next
  374.     error$=""
  375.     here
  376.     r$=error$+"Available Library numbers:"+bar$+ MakeFreeList{}
  377.     r$+bar$+"Enter new library number:"
  378.     ln(k)=RTEZGetLongRange("NewFDConvert",r$,1,bestlibnr,bestlibnr)
  379.     If ln(k)=0
  380.       End
  381.     EndIf
  382.     If ln(k)>255 OR ln(k)<1
  383.       error$="ERROR: Out of range!"+bar$
  384.       Goto here
  385.     EndIf
  386.     If usedlibs(ln(k))=1
  387.       error$="ERROR: Library number "+Str$(ln(k))+" already used!"+bar$
  388.       Goto here
  389.     EndIf
  390.   EndIf
  391. Next
  392.  
  393. ln=ln(1)
  394. ;
  395. li2$=li$
  396. clearup:k=Instr(li2$,":"):If k Then li2$=Mid$(li2$,k+1):Goto clearup
  397. clearup2:k=Instr(li2$,"/"):If k Then li2$=Mid$(li2$,k+1):Goto clearup
  398. ;
  399. nn=127:li=0
  400. ;
  401. For tk=1 To n
  402. ;
  403. nn+1
  404. If nn=128
  405.   ;
  406.   If li Then Gosub libdone
  407.   ;
  408.   li+1
  409.   If WriteFile(0,dest$+li2$+Str$(li))=0
  410.     dummy=RTEZRequest("Error creating File",li$+Str$(li),"DAMN!")
  411.     Pop For
  412.     Return
  413.   EndIf
  414.   ;
  415.   co$=Mkl$(0)+Mki$(ln(li))+String$(Chr$(0),20)
  416.   If li=1 Then co$+Mki$(1) Else co$+Mki$(0)
  417.   co$+String$(Chr$(0),20)
  418.   nn=1
  419.   WColour 2,0
  420.   NPrint "-------------------------------"
  421.   WPrintScroll
  422.   WColour 3,0
  423.   NPrint " Creating ",li$
  424.   WPrintScroll
  425.   NPrint" "
  426.   WPrintScroll
  427.   WColour 1,0
  428.   ;
  429. EndIf
  430. ;
  431. NPrint " CREATING : ",n$(tk),"_",suf$," ",h$(tk)," ",p$(tk)
  432. WPrintScroll
  433. co$+Mki$(6)+Mkl$(0)+Mki$(ln(1))+Mki$(o(tk)) ;type and link
  434. ;
  435. p$=Mid$(p$(tk),2)
  436. While Left$(p$,1)="a" OR Left$(p$,1)="d"
  437.   If Left$(p$,1)="a"
  438.     co$+Chr$(Val(Mid$(p$,2,1))+16)
  439.   Else
  440.     co$+Chr$(Val(Mid$(p$,2,1)))
  441.   EndIf
  442.   p$=Mid$(p$,4)
  443. Wend
  444. ;
  445. co$+Chr$(-1)
  446. align{}
  447. co$+Mkl$(0)+Mki$(0)+n$(tk)+"_"+suf$+Chr$(0)+h$(tk)+Chr$(0)
  448. align{}
  449. ;
  450. Next
  451. ;
  452. If co$ Then Gosub libdone
  453. ;
  454. Return
  455.  
  456. .libdone
  457. ;
  458. If li=1 ;first one - create 'openlibrary' stuff!
  459.   ;
  460.   ;make 'init' nullsub!
  461.   ;
  462.   fillin{$16}
  463.   co$+String$(Chr$(0),12):iat=Len(co$)
  464.   co$+Mkl$(0)+Mkl$(0)
  465.   ;
  466.   ;make 'finit' nullsub!
  467.   ;
  468.   fillin{$1c}
  469.   co$+String$(Chr$(0),6)+Mki$(ln(1))+Mki$($1100)+Mki$(0)
  470.   co$+Mkl$(0):fat=Len(co$)
  471.   co$+Mkl$(0)+Mkl$(0)
  472.   ;
  473.   co$+Mki$(-1)+Mkl$(0)
  474.   ;
  475.   ;make 'libinit' code!
  476.   ;
  477.   fillin{iat}
  478.   co$+Mkl$($2c780004)         ;     move.l   4.w,a6
  479.   If islib
  480.     co$+Mkl$($43fa0022)         ;loop lea      libname(pc),a1
  481.   Else
  482.     co$+Mkl$($43fa001d)
  483.   EndIf
  484.   co$+Mki$($7000)             ;     moveq    #0,d0
  485.   co$+Mki$($4eae)
  486.   If islib
  487.     co$+Mki$(-552)            ;     jsr      openlibrary(a6)
  488.   Else
  489.     co$+Mki$(-498)            ;     jsr      openresource(a6)
  490.   EndIf
  491. ;  co$+Mki$($4a80)             ;     tst.l    d0
  492. ;  co$+Mkl$($6700fff4)         ;     beq      loop
  493.   co$+Mki$($4e75)             ;     rts
  494.   ;
  495.   ;make 'libfinit' code!
  496.   ;
  497.   fillin{fat}
  498.   If islib
  499. ;    co$+Mkl$($2c780004)   ;     move.l    4.w,a6
  500. ;    co$+Mkl$($4eeefe62)   ;     jmp       -$19e(a6)
  501.  
  502. ; Well, the fellowing code should create something like this:
  503. ; MOVE.l  a1,d0
  504. ; TST.l d0
  505. ; BEQ skip
  506. ; MOVEA.l 4,a6
  507. ; JSR -$19e(a6)
  508. ; skip:
  509. ; RTS
  510.  
  511.     co$+Mkl$($20094A80)
  512.     co$+Mkl$($6700000C)
  513.     co$+Mkl$($2C790000)
  514.     co$+Mkl$($00044EAE)
  515.     co$+Mkl$($FE624E75)
  516.     co$+Mkl$($70004E75)
  517.   Else
  518.     co$+Mki$($4e75)
  519.   EndIf
  520.   ;
  521.   ;add 'name.library'
  522.   ;
  523.   co$+li$+Chr$(0)
  524.   ;
  525.   ;All Code Done! - now for reloc stuff
  526.   ;
  527.   re$=Mkl$($3ec)+Mkl$(4)+Mkl$(0)+Mkl$($16)+Mkl$($1c)
  528.   re$+Mkl$(iat)+Mkl$(fat)+Mkl$(0)
  529.   ;
  530. Else
  531.   ;
  532.   co$+Mki$(-1)+Mkl$(0)
  533.   ;
  534. EndIf
  535. ;
  536. While (Len(co$) AND 3)
  537.   co$+Chr$(0)
  538. Wend
  539. ;
  540. ;Now for header stuff
  541. ;
  542. cl=Len(co$)/4
  543. ;
  544. in$=Mkl$($3f3)+Mkl$(0)+Mkl$(1)+Mkl$(0)+Mkl$(0)
  545. in$+Mkl$(cl)+Mkl$($3e9)+Mkl$(cl)
  546. ;
  547. FileOutput 0
  548. Print in$,co$,re$,Mkl$($3f2)
  549. CloseFile 0:DefaultOutput
  550. ;
  551. co$="":re$="":Return
  552.  
  553. .sussfd
  554. n=0:bi=-30:li$="":gen=-1
  555. While NOT Eof(0)
  556.   l$=Edit$(256)
  557.   If Left$(l$,1)<>"*"
  558.     If Left$(l$,2)="##"
  559.       c$=LCase$(Mid$(l$,3)):c$=StripLead$(c$,32)
  560.       If Left$(c$,6)="public" Then gen=-1
  561.       If Left$(c$,7)="private" Then gen=0
  562.       If Left$(c$,3)="end" Then Return
  563.       If Left$(c$,4)="bias" Then bi=-Val(Mid$(c$,5))
  564.     Else
  565.       If gen
  566.         b1=Instr(l$,"(")     ;first bracket
  567.         b2=Instr(l$,"(",b1+1) ;second bracket
  568.         If b1>0 AND b2>0
  569.           n+1
  570.           o(n)=bi
  571.           n$(n)=Left$(l$,b1-1)
  572.           h$(n)=Mid$(l$,b1,b2-b1):If h$(n)="()" Then h$(n)=""
  573.           p$(n)=LCase$(Mid$(l$,b2))
  574.         Else
  575.           NPrint "Error in file :"
  576.           WPrintScroll
  577.           NPrint l$
  578.           WPrintScroll
  579.         EndIf
  580.       EndIf
  581.       bi-6
  582.       ;
  583.     EndIf
  584.   Else
  585.     n$=Mid$(l$,2):n$=StripLead$(n$,32)
  586.     If Left$(n$,1)=Chr$(34)
  587.       n2=Instr(n$,Chr$(34),2)-2
  588.       If n2>0
  589.         li$=Mid$(n$,2,n2)
  590.       EndIf
  591.     EndIf
  592.   EndIf
  593. Wend
  594. Return
  595.  
  596.